﻿'Copyright (c) 2009 Grailtek

'Permission is hereby granted, free of charge, to any person
'obtaining a copy of this software and associated documentation
'files (the "Software"), to deal in the Software without
'restriction, including without limitation the rights to use,
'copy, modify, merge, publish, distribute, sublicense, and/or sell
'copies of the Software, and to permit persons to whom the
'Software is furnished to do so, subject to the following
'conditions:

'The above copyright notice and this permission notice shall be
'included in all copies or substantial portions of the Software.

'THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
'EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
'OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
'NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
'HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
'WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
'FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
'OTHER DEALINGS IN THE SOFTWARE.

Imports System.ExecutorServices
Imports System.DataExecutorServices
Imports Microsoft.SqlServer.Management.Smo
Imports Microsoft.SqlServer.Management.Common
Imports System.Reflection
Imports System.Runtime.CompilerServices
Imports System.DataExecutorServices.Exceptions
Imports System.Data.SqlClient
Imports System.Aspect
Imports System.Text.RegularExpressions

Public Module SqlManager

    Public Sub UpdateAllSqlDataCallContracts(ByVal Assy As Assembly)
        For Each c As SqlDataCallAttribute In GetAllSqlDataCalls(Assy)
            c.UpdateContract()
        Next
    End Sub

    Public Function GetAllSqlDataCalls(ByVal Assy As Assembly) As SqlDataCallAttribute()
        Return GetAspectSet(Of SqlDataCallAttribute)(Assy)
    End Function

    <Extension()> _
    Public Sub UpdateContract(ByVal d As SqlDataCallAttribute)
        Using conn As New System.Data.SqlClient.SqlConnection(d.ConnectionString)
            Dim sc As New ServerConnection(conn)
            Dim s As New Server(sc)
            Dim db As Database = s.Databases(d.Database)
            If db Is Nothing Then Throw New ArgumentException(String.Format("Database '{0}' does not exist.", d.Database))
            Dim sp As StoredProcedure
            If db.StoredProcedures.Contains(d.RegisterName) Then
                sp = db.StoredProcedures(d.RegisterName)
                RefreshContract(sp, d)
                sp.Alter()
            Else
                sp = New StoredProcedure(db, d.RegisterName)
                SetStoredProcedureToDefault(sp, d)
                sp.Create()
            End If
        End Using
    End Sub

    Private Sub SetStoredProcedureToDefault(ByVal sp As StoredProcedure, ByVal c As SqlDataCallAttribute)
        sp.TextMode = False
        sp.AnsiNullsStatus = False
        sp.QuotedIdentifierStatus = False
        For Each p As InputMapping In c.DelegateInfo.InputMappings
            Dim spp As New StoredProcedureParameter(sp, "@" & p.Name, DataTypeConverter.GetDataTypeFor(p.FieldType))
            sp.Parameters.Add(spp)
        Next
        sp.TextBody = Resources.GetSQL(SQL.DefaultSprocBody)
        RefreshContract(sp, c)
    End Sub

    Private ReadOnly SprocBeginRegEx As Regex = New Regex("alter\s+proc|create\s+proc", RegexOptions.IgnoreCase)

    Private Sub RefreshContract(ByVal sp As StoredProcedure, ByVal c As SqlDataCallAttribute)
        sp.TextMode = True
        Dim ExistingHeader As String = sp.TextHeader
        Dim m As Match = SprocBeginRegEx.Match(ExistingHeader)
        If Not m.Success Or m.Captures.Count > 1 Then Throw New InvalidOperationException(String.Format("unable to parse procedure {0} with header content {1}", sp.Name, sp.TextHeader))
        Dim ProcBegin As Integer = m.Captures(0).Index
        Dim ServerContractText As String = ExistingHeader.Substring(0, ProcBegin)
        Dim BeginCommentIndex As Integer = ServerContractText.IndexOf("/*" + Environment.NewLine)
        Dim EndCommentIndex As Integer = ServerContractText.LastIndexOf(Environment.NewLine + "*/")
        If BeginCommentIndex > -1 AndAlso EndCommentIndex > -1 Then
            ServerContractText = ServerContractText.Substring(BeginCommentIndex + 4, EndCommentIndex - BeginCommentIndex - 4)
        End If
        Dim ServerContract As Contract = Nothing
        Try
            ServerContract = Contract.Deserialize(ServerContractText)
        Catch ex As InvalidOperationException
            'Debug.Fail("server contract failed to parse")
            'NOTE: we don't really care if the xml doesn't parse, a DBA could mess with it, the contract structure could change - if it fails then we will just replace it
        End Try
        Dim LocalContract As New Contract(c)
        If Not LocalContract.Equals(ServerContract) Then
            Dim ProcBeginText As String = sp.TextHeader.Substring(ProcBegin)
            sp.TextHeader = "/*" & Environment.NewLine & LocalContract.Serialize & Environment.NewLine & "*/" & Environment.NewLine & ProcBeginText
        End If
    End Sub

    'Private ReadOnly DbTypesLookup As Dictionary(Of Type, DataType) = GetDbTypesLookup()
    ''NOTE: these data type lengths are default values,
    ''   auto-registration is a convenience, the developer will still have to write the proc
    'Private Function GetDbTypesLookup() As Dictionary(Of Type, DataType)
    '    Dim ret As New Dictionary(Of Type, DataType)
    '    ret.Add(GetType(Byte()), DataType.Binary(20))
    '    ret.Add(GetType(Boolean), DataType.Bit)
    '    ret.Add(GetType(Date), DataType.DateTime)
    '    ret.Add(GetType(DateTime), DataType.DateTime)
    '    ret.Add(GetType(Decimal), DataType.Decimal(18, 9))
    '    ret.Add(GetType(Single), DataType.Float)
    '    ret.Add(GetType(Integer), DataType.Int)
    '    ret.Add(GetType(Guid), DataType.UniqueIdentifier)
    '    ret.Add(GetType(String), DataType.VarChar(20))
    '    Return ret
    'End Function

    'Private NotInheritable Class DbTypeMapper
    '    Private Sub New()
    '    End Sub
    '    Public Shared Function GetDBType(ByVal type As Type) As DbType
    '        Dim m As MethodInfo = GetDbTypeMethod.MakeGenericMethod(New Type() {type})
    '        Return DirectCast(m.Invoke(Nothing, Nothing), DbType)
    '    End Function
    '    Private Shared ReadOnly GetDbTypeMethod As MethodInfo = GetType(DbTypeMapper).GetMethod("_GetDbType", BindingFlags.Static Or BindingFlags.NonPublic)
    '    Private Shared Function _GetDbType(Of T)() As DbType
    '        Return InternalDbTypeMapper(Of T).DbType
    '    End Function
    '    Private Class InternalDbTypeMapper(Of T)
    '        Public Shared ReadOnly Property DbType() As DbType
    '            Get
    '                Return _DbTypeInfo.DbType
    '            End Get
    '        End Property
    '        Private Shared ReadOnly _DbTypeInfo As New DbTypeInfo
    '        Private Class DbTypeInfo
    '            Public Sub New()
    '                Dim o As T
    '                Dim p As New SqlParameter With {.Value = o}
    '                DbType = p.DbType
    '            End Sub
    '            Public DbType As DbType
    '        End Class
    '    End Class
    'End Class

End Module